# Definition and implementation of the Document class.

package require Iexpect
package require Iarray

itcl::class Document {

	common eVersion "1.0"

	constructor {} {
		set iGenerics [iarray::code [iarray::Sequence #auto]]
		set iDefaults [iarray::code [iarray::Sequence #auto]]
		set iSetup [iarray::code [Play #auto {}]]
		set iPages [iarray::Sequence #auto]
	}
	destructor {
		itcl::delete object $iGenerics
		itcl::delete object $iDefaults
		itcl::delete object $iSetup
		itcl::delete object $iPages
	}

	method autoRead {fileSpec}
	method autoWrite {fileSpec args}

	# To create multiliners in Generics and Defaults, insert newline characters.
	method updateGeneric {topic {contents {}}} {$iGenerics set $topic $contents}
	method removeGeneric {topic} {$iGenerics rename $topic {}}
	method getGenerics {} {$iGenerics get}
	method getGeneric {topic} {$iGenerics of $topic}
	method genericNames {} {$iGenerics names}

	method updateDefault {topic {contents {}}} {$iDefaults set $topic $contents}
	method removeDefault {topic} {$iDefaults rename $topic {}}
	method getDefaults {} {$iDefaults get}
	method getDefault {topic} {$iDefaults of $topic}
	method defaultNames {} {$iDefaults names}

	method appendToDescription {lines} {
		eval lappend iDescription $lines
	}
	method prependToDescription {lines} {
		set iDescription [eval lappend lines $iDescription]
	}
	method setDescription {lines} {set iDescription $lines}
	method getDescription {} {return $iDescription}
	
	method getSetup {} {return $iSetup}

	method pageNames {} {
		$iPages names
	}
	method hasPage {label} {
		$iPages has $label
	}
	method getPage {label} {
		$iPages of $label
	}
	method addPage {label} {
		set page [iarray::code [Play #auto {}]]
		$iPages acquire $label $page
		return $page
	}
	method removePage {label} {
		$iPages rename $label {}
	}

	protected proc collectResources {resources sequence}

	variable iGenerics
	variable iDefaults
	variable iDescription {}
	variable iSetup
	variable iPages
}

itcl::body Document::autoRead {fileSpec} {
	set I [iarray::code [iexpect::Expect #auto -white -file $fileSpec]]

	set iPartList ""

	$I will alert "^%<(\[A-Z\]\[a-zA-Z\]*) .+>$" {
		assert 0 {
			Didn't expect part <[$I get match 1]> at line [$I get nr_line]
		}
	} "^%</(\[A-Z\]\[a-zA-Z\]*)>" {
		assert 0 {
			Didn't expect closing part </[$I get match 1]> at line [$I get nr_line]
		}
	} "^$" {
		$I continue
	} eof {
		assert 0 {
			Didn't expect eof yet.
		}
	} default {
		assert 0 {
			Didn't expect <[$I get unmatched]>
		}
	}

	$I will guard "^%%IncludeResource: (\[^ \]+) " {
		addResource [$I get match 1] [Story::fromText [$I get unchecked] remainder]
		assert {![string length [string trim $remainder]]} {
			<[$I get output]> contains more than one resource?!
		}
		$I continue
	} -xp alert

	$I will part "^%<(\[A-Z\]\[A-Za-z\]*) (.+)/>$" {
		set class [$I get match 1]
		assert {![string length [itcl::find classes $class]]} {
			No such Part class <$class>.
		}

		set name [Story::fromText [$I get match 2] tokens]
		set part [$class #auto {}]
		assert {[$part isa Part]} {
			No such Part class <$class>.
		}
		$part parseAttributes $tokens

		assert [hasSequence] {
			No sequence in class <$class>.
		}
		[getSequence] acquire $name [iarray::code $part]

		$I continue
	}  "^%<(\[A-Z\]\[A-Za-z\]*) (.+)>$" {
		set class [$I get match 1]
		assert {![string length [itcl::find classes $class]]} {
			No such Part class <$class>.
		}

		set name [Story::fromText [$I get match 2] tokens]
		set part [$class #auto {}]
		assert {[$part isa Part]} {
			No such Part class <$class>.
		}
		$part parseAttributes $tokens

		set afterwards [$I will expect -after]
		$I expect after
		$I expect line "%<\[+\] (.*)>" {
			$part parseAttributes [$I get match 1]
			$I continue
		} -notransfer "^.*$" {
		}
		$I expect after "^%</$class>$" {
		} -xp guard
		$part autoRead $I [getTributes]
		$I expect after -xp $afterwards
		$I will $afterwards

		assert [hasSequence] {
			No sequence in class <$class>.
		}
		[getSequence] acquire $name [iarray::code $part]

		$I continue
	}

	$I expect after -xp alert

	$I expect line "^%!"

	set topic {}
	$I expect line "^%%EndComments$" {
	} "^%%(\[A-Z\]\[a-zA-Z\]*)$" {
		$iGenerics set [$I get match 1] {}
		set topic {}
		$I continue
	} "^%%(\[A-Z\]\[a-zA-Z\]*): " {
		$iGenerics set [set topic [$I get match 1]] [$I get unchecked]
		$I continue
	} "^%%\[+\] " {
		assert {[string length $topic]} {
			No topic found for additional generic comments.
		}
		$iGenerics set $topic "[$iGenerics of $topic]\n[$I get unchecked]"
		$I continue
	}

	$I expect line "^%%BeginDefaults$" {
		set topic {}
		$I expect line "^%%EndDefaults$" {
		} "^%%(\[A-Z\]\[a-zA-Z\]*)$" {
			$iDefaults set [$I get match 1] {}
			set topic {}
			$I continue
		} "^%%(\[A-Z\]\[a-zA-Z\]*): " {
			$iDefaults set [set topic [$I get match 1]] [$I get unchecked]
			$I continue
		} "^%%\[+\] " {
			assert {[string length $topic]} {
				No topic found for additional default comments.
			}
			$iDefaults set $topic "[$iDefaults of $topic]\n[$I get unchecked]"
			$I continue
		}
	} -notransfer "^%%BeginSetup$" {
	} "^% " {
		lappend iDescription [$I get unchecked]
		$I continue
	}

	$I expect line "^%%BeginSetup$" {
	}

	$I expect line "^%<Play Setup( .+)?/>$" {
		if [string length [$I get match 1]] {
			$iSetup parseAttributes [$I get match 1]
		}
	}  "^%<Play Setup( .+)?>$" {
		if [string length [$I get match 1]] {
			$iSetup parseAttributes [$I get match 1]
		}

		$I expect after
		$I expect line "%<\[+\] (.*)>" {
			$iSetup parseAttributes [$I get match 1]
			$I continue
		} -notransfer "^.*$" {
		}
		$I expect after "^%</Play>$" {
		} -xp guard
		$iSetup autoRead $I {}
		$I expect after -xp alert
	}


	$I expect line "^%%EndSetup$" {
	}

	$I expect line "^%%Page: (.+) \[0-9\]+$" {
		set label [Story::fromText [$I get match 1] dummy]
		if [$iPages has $label] {
			set page [$iPages of $label
		} else {
			set page [iarray::code [Play #auto {}]]
			$iPages acquire $label $page
		}

		$I expect line "^%<Play Page( .+)?/>$" {
			if [string length [$I get match 1]] {
				$page parseAttributes [$I get match 1]
			}
		}  "^%<Play Page( .+)?>$" {
			if [string length [$I get match 1]] {
				$page parseAttributes [$I get match 1]
			}

			$I expect after
			$I expect line "%<\[+\] (.*)>" {
				$page parseAttributes [$I get match 1]
				$I continue
			} -notransfer "^.*$" {
			}
			$I expect after "^%</Play>$" {
			} -xp guard
			$page autoRead $I {}
			$I expect after -xp alert
		}
		
		$I continue
	} "^%%Trailer" {
	} eof

	itcl::delete object $I
}

itcl::body Document::autoWrite {fileSpec args} {

	# Collect all resources.
	set resources [iarray::Array #auto [$iSetup getResources]]
	collectResources $resources [$iSetup getSequence]
	collectResources $resources $iPages
	set hasResources [expr [llength [$resources names]] > 0]

	$iGenerics unset DocumentNeededResources
	$iDefaults unset PageResources

	$iGenerics set Pages "(atend)"

	set U [iarray::code [Story #auto $fileSpec $args]]

	# Fully DSC compliant?
	set compliant [$U getAttribute compliant 1]

	if $compliant {
		$U write version "PS-Adobe-3.0"
	} else {
		$U write version "PS-Adobe-2.0"
	}

	foreach {topic contents} [$iGenerics get] {
		set contents [split $contents "\n"]
		if {![llength $contents]} {
			$U write comment $topic
		} else {
			$U write comment $topic [lindex $contents 0]
			foreach line [lrange $contents 1 end] {
				$U write continuation $line
			}
		}
	}
	if {$compliant && $hasResources} {
		$U write resources DocumentNeededResources [$resources get]
	}
	$U write comment EndComments

	if {$compliant && ([llength [$iDefaults names]] || $hasResources)} {
		$U write gap
		$U write comment BeginDefaults
		foreach {topic contents} [$iDefaults get] {
			set contents [split $contents "\n"]
			if {![llength $contents]} {
				$U write comment $topic
			} else {
				$U write comment $topic [lindex $contents 0]
				foreach line [lrange $contents 1 end] {
					$U write continuation $line
				}
			}
		}
		if $hasResources {
			$U write resources PageResources [$resources get]
		}	
		$U write comment EndDefaults
	}

	itcl::delete object $resources

	if [llength $iDescription] {
		$U write gap
		foreach line $iDescription {$U write line "% $line"}
	}

	$U write gap
	if $compliant {$U write comment BeginSetup}
	$U write part $iSetup Setup
	if $compliant {$U write comment EndSetup}

	if [llength [$iPages names]] {
		set idx 0
		foreach {label page} [$iPages get] {
			incr idx
			$U write gap
			$U write comment Page "[Story::toText $label] $idx"
			$U write part $page Page
		}
		$U write gap
		$U write comment Trailer
		$U write comment Pages $idx
	}

	itcl::delete object $U
}

itcl::body Document::collectResources {resources sequence} {
	foreach {name part} [$sequence get] {
		foreach {key values} [$part getResources] {
			if {![$resources has $key]} {
				$resources set $key $values
			} else {
				foreach value $values {
					if {[lsearch [$resources of $key] $value] == -1} {
						$resources set $key [concat [$resources of $key] $value]
					}
				}
			}
		}
		if [$part hasSequence] {
			collectResources $resources [$part getSequence]
		}
	}
}
